home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.12 Dec 90 / Pattern Scroller / Pas_To_ResCode.LDEF.Pas next >
Encoding:
Pascal/Delphi Source File  |  1989-01-17  |  4.9 KB  |  192 lines  |  [TEXT/TPAS]
  1. Program Pas_to_ResCode_LDEF;
  2. {****  Written and © 1989 by Shelly Mendlinger  ****}
  3. {****  Brooklyn, New York                       ****}
  4.  
  5. uses
  6.     memtypes,
  7.     quickdraw,
  8.     osintf,
  9.     toolintf,
  10.     packintf;
  11. const
  12.     resFile     = 'PatList.rsrc';
  13.     RType       = 'LDEF';
  14.     resID       = 1000;
  15.     resName     = 'PatList Def';
  16. var
  17.     CodePtr     : procPtr;
  18.     CodeHand    : handle;
  19.     CodeSize    : size;
  20.     oldResNum,
  21.     newResNum,
  22.     err         : integer;
  23.     str         : str255;
  24.     goAhead     : boolean;
  25.  
  26. {*** This Proc is turned into res code ***}   
  27. Procedure theCode(Message : integer;
  28.     isSelect    : boolean;
  29.     cRect       : rect;
  30.     theCell     : cell;
  31.     LDataOffSet,
  32.     LdataLen    : integer;
  33.     aList       : Listhandle);
  34. type
  35.     patPtr      = ^pattern;
  36. var
  37.     aPat        : patPtr;
  38.     oldClip     : rgnHandle;
  39.     hand        : handle;
  40.     aRect       : rect;
  41. begin
  42.     {--- what's the story ---}
  43.     case Message of
  44.     
  45.     LInitMsg: {initialize the list}
  46.       begin
  47.         {--- select one cell at a time ---}
  48.         aList^^.selFlags := LOnlyOne;
  49.         {--- frame the list ---}
  50.         Pennormal;
  51.         aRect := aList^^.rView;
  52.         inSetRect(aRect,-1,-1);
  53.         framerect(aRect);
  54.       end;{init}
  55.     
  56.     LdrawMsg: {draw theCell}
  57.       begin
  58.         {--- save port's cliprgn ---}
  59.         oldclip := aList^^.port^.cliprgn;
  60.         {--- change port's cliprgn, IM says so ---}
  61.         rectRgn(aList^^.port^.cliprgn,cRect);
  62.         {--- calc cell's data address ---}
  63.         Hand := handle(aList^^.cells); {handle to data}
  64.         aPat := patPtr(pointer(ord(hand^) + LDataOffSet)); {ptr to pat}
  65.         {--- draw cell frame & pat ---}
  66.         framerect(cRect);
  67.         aRect := cRect;
  68.         inSetRect(aRect,5,5);
  69.         FillRect(aRect,aPat^);
  70.         FrameRect(aRect);
  71.         {--- restore port's clip ---}
  72.         aList^^.port^.cliprgn := oldClip;
  73.       end;{draw}
  74.       
  75.   LHiliteMsg: {hilite theCell}
  76.     begin
  77.         {--- same clip stuff as above --}
  78.         oldclip := aList^^.port^.cliprgn;
  79.         rectRgn(aList^^.port^.cliprgn,cRect);
  80.         {--- Xor a frame ---}
  81.         pennormal;
  82.         penMode(patXor);
  83.         penSize(4,4);
  84.         aRect:= cRect;
  85.         inSetRect(aRect,-5,-5);
  86.         frameRect(cRect);
  87.         pennormal;
  88.         {--- clip stuff ---}
  89.         aList^^.port^.cliprgn := oldClip;
  90.     end;{hilite}
  91.  otherwise
  92.  end;{case message}
  93. end;{proc theCode}
  94.  
  95. {--- mark the end of theCode ---}
  96. Procedure Marker;
  97. begin
  98. end;{proc mark}
  99.  
  100. Procedure EventLoop;
  101. var
  102.     evt     : eventRecord;
  103.     GetOut  : boolean;
  104. begin
  105.     GetOut := false;
  106.     repeat
  107.         if getNextEvent(everyevent,evt) then
  108.           case evt.what of
  109.             {--- any key to quit ---}
  110.             keyDown     :  GetOut  := true;
  111.             {--- click to proceed ---}
  112.             mouseDown   :  GoAhead := true;
  113.             otherwise
  114.          end;{case what}
  115.    until GetOut or GoAHead;
  116. end;{proc eventloop}
  117.  
  118. Begin {main}
  119.     {--- address of theCode ---}
  120.     CodePtr := @theCode;
  121.     {--- pointer math ---}
  122.     CodeSize := size(ord(@Marker) - ord(codePtr));
  123.     {--- get handle for AddResource ---}
  124.     Err := PtrToHand(CodePtr,CodeHand,CodeSize);
  125.     if err <> noErr then
  126.       begin
  127.         numtoString(err,str);
  128.         str := 'OS ERROR GETTING HANDLE.  #' + str; 
  129.         moveto(100,100);
  130.         drawstring(str);
  131.       end { error}
  132.     else
  133.       begin
  134.         goAhead := false;
  135.         {--- save current res fie ---}
  136.         oldResNum := curResfile;
  137.         {--- draw interface ---}
  138.         textfont(0);
  139.         textsize(18);
  140.         moveto(20,25);
  141.         drawstring('ANY KEY TO QUIT');
  142.         
  143.         moveto(20,55);
  144.         drawstring('CLICK TO ADD RESOURCE');
  145.         
  146.         str := 'Res File: ' + ResFile;
  147.         moveto(100,75);
  148.         drawstring(str);
  149.         
  150.         str := 'Res Type: ' + RType;
  151.         moveto(100,95);
  152.         drawstring(str);
  153.         
  154.         numtostring(ResID,str);
  155.         str := 'Res Id: ' + str;
  156.         moveto(100,115);
  157.         drawstring(str);
  158.         
  159.         str := 'Res Name: ' + ResName;
  160.         moveto(100,135);
  161.         drawstring(str);
  162.         
  163.         numtostring(CodeSize,str);
  164.         str := 'Code size: ' + str + ' bytes';
  165.         moveto(100,155);
  166.         drawstring(str);
  167.         
  168.     
  169.         EventLoop;
  170.         
  171.         if GoAhead then
  172.           begin
  173.           
  174.             {******* OPTIONAL. If neened,usually done once***}   
  175.             createResFile(resFile);
  176.             {******* then new resCode &ID added to file  ****}
  177.                
  178.             {--- open res file --}
  179.             newResNum := openResFile(ResFile);
  180.             {--- write to res file ---}
  181.             addResource(CodeHand,RType,resID,ResName);
  182.             {--- close selected res file ---}
  183.             closeresFile(newResNum);
  184.             {--- restore orig. res file ---}
  185.             useResFile(oldResNum);
  186.           end;{do it}
  187.         end;{else no err}
  188.  end.{prog pas to res code}
  189.         
  190.     
  191.     
  192.